home *** CD-ROM | disk | FTP | other *** search
- ;BB.Fade - Blanker-module for BlitzBlank
- ;Copyright 1993 by Thomas Boerkel
-
- CloseEd
-
- NEWTYPE.spritedata
- a.w
- b
- c
- d
- e
- f
- End NEWTYPE
-
- NEWTYPE.tab
- a.w
- c
- r.l
- g
- b
- e
- End NEWTYPE
-
- NEWTYPE.rgb
- r.l
- g
- b
- End NEWTYPE
-
- DEFTYPE.spritedata *sprdata
- DEFTYPE.SimpleSprite spr
-
- DEFTYPE.Screen *myscreen,*firstscreen
- DEFTYPE.ViewPort *vp
- DEFTYPE.ColorMap *cm
- DEFTYPE.Message *msg
- DEFTYPE.MsgPort *port
- DEFTYPE.tab p
- DEFTYPE.l
-
-
-
- Statement stringborder{x,y,w,h}
- Wline x+1,y+h+2,x+1,y,x+w+8,y,1
- Wline x+w+10,y-1,x+w+10,y+h+4,x-1,y+h+4,1
- Wline x,y+h+3,x,y,1
- Wline x+w+11,y-1,x+w+11,y+h+4,1
- Wline x-1,y+h+3,x-1,y-1,x+w+10,y-1,2
- Wline x+w+9,y,x+w+9,y+h+3,x+1,y+h+3,2
- Wline x-2,y+h+4,x-2,y-1,2
- Wline x+w+8,y+1,x+w+8,y+h+2,2
- End Statement
-
-
-
- Statement set{n,r,g,b}
- SHARED *vp.ViewPort,p.tab
- p\a=1
- p\c=n
- p\r=r+256*r+65536*r+16777216*r
- p\g=g+256*g+65536*g+16777216*g
- p\b=b+256*b+65536*b+16777216*b
- LoadRGB32_ *vp,p
- End Statement
-
- Select Par$(1)
- Case "BLANK"
-
- *sprdata=AllocMem_(SizeOf.spritedata,#MEMF_CHIP|#MEMF_CLEAR)
-
- name$="BB.BlankModule"+Chr$(0)
- *port=CreateMsgPort_()
- *port\mp_Node\ln_Name=&name$
- *port\mp_Node\ln_Pri=1
- AddPort_ *port
-
- Gosub readconfig
-
- lib$="intuition.library"+Chr$(0)
- *ibase.IntuitionBase=OpenLibrary_(&lib$,39)
- CloseLibrary_(*ibase)
- If *ibase
- v39=1
- Else
- *ibase.IntuitionBase=OpenLibrary_(&lib$,37)
- CloseLibrary_(*ibase)
- EndIf
- *firstscreen=*ibase\FirstScreen
-
- VWait
- ChangeSprite_ 0,spr,*sprdata
-
- depth=*firstscreen\BitMap\Depth
- colors=2^depth
- *vp=*firstscreen\ViewPort
- *cm=*vp\ColorMap
-
- If v39
- Dim pal.rgb(colors)
- Dim col.l(colors*3+3)
- col(0)=colors LSL 16
- USEPATH pal(i)
- Else
- Dim pal37(colors)
- EndIf
-
- For i=0 To colors-1
- If v39
- GetRGB32_ *cm,i,1,pal(i)
- \r=\r AND 255
- \g=\g AND 255
- \b=\b AND 255
- Else
- pal37(i)=GetRGB4_(*cm,i)
- EndIf
- Next i
-
-
- For j=100 To final Step -(depth/3+1)
- For i=0 To colors-1
- If v39
- r=\r*j/100
- g=\g*j/100
- b=\b*j/100
- col(1+i*3)=r|r LSL 8|r LSL 16|r LSL 24
- col(2+i*3)=g|g LSL 8|g LSL 16|g LSL 24
- col(3+i*3)=b|b LSL 8|b LSL 16|b LSL 24
- Else
- SetRGB4_ *vp,i,(pal37(i)LSR8 AND 15)*j/100,(pal37(i)LSR4 AND 15)*j/100,(pal37(i) AND 15)*j/100
- EndIf
- Next i
- If v39
- LoadRGB32_ *vp,&col(0)
- EndIf
- *msg=GetMsg_(*port)
- If *msg
- j=0
- EndIf
- VWait
- Next j
-
- While *msg=0
- WaitPort_ *port
- *msg=GetMsg_(*port)
- Wend
-
- For i=0 To colors-1
- If v39
- col(1+i*3)=\r|\r LSL 8|\r LSL 16|\r LSL 24
- col(2+i*3)=\g|\g LSL 8|\g LSL 16|\g LSL 24
- col(3+i*3)=\b|\b LSL 8|\b LSL 16|\b LSL 24
- Else
- SetRGB4_ *vp,i,pal37(i)LSR8 AND 15,pal37(i)LSR4 AND 15,pal37(i) AND 15
- EndIf
- Next i
-
- If v39
- LoadRGB32_ *vp,&col(0)
- EndIf
- RemPort_ *port
- DeleteMsgPort_ *port
- FreeMem_ *sprdata,SizeOf.spritedata
- End
-
- Case "INFO"
-
- title$="Fade"+Chr$(0)
- reqtext$="Fade - Module for BlitzBlank"+Chr$(10)
- reqtext$+Chr$(169)+" 1993 by Thomas Brkel"+Chr$(10)+Chr$(10)
- reqtext$+"Your actual screen will be faded down."+Chr$(10)+Chr$(10)
- reqtext$+"Choose the remaining brightness in the config-window."+Chr$(0)
- gadget$="OK"+Chr$(0)
-
- easy.EasyStruct\es_StructSize=SizeOf.EasyStruct
- easy\es_Title=&title$
- easy\es_TextFormat=&reqtext$
- easy\es_GadgetFormat=&gadget$
-
- EasyRequestArgs_ 0,easy,0,0
-
- Case "CONFIG"
- *myscreen=LockPubScreen_(0)
- width=*myscreen\Width
- height=*myscreen\Height
- font=*myscreen\Font\ta_YSize
- Gosub readconfig
- WbToScreen 0
- BorderPens 0,0
- StringGadget 0,100,25,0,0,3,30
- SetString 0,0,Str$(final)
- Window 0,width/2-90,height/2-25,180,50,$100e,"Fade",1,2,0
- stringborder{100,25,30,8}
- WColour 2
- WLocate 30,24-font
- Print "Fade to"
- WLocate 30,24-font+8
- Print "(0-99)"
-
- ActivateString 0,0
- Repeat
- ev=WaitEvent
- Until ev=$200 OR ev=$40
- final=Val(StringText$(0,0))
- Free Window 0
- Gosub writeconfig
- UnlockPubScreen_ 0,*myscreen
- End Select
-
- End
-
- .readconfig
- path$=Par$(9)
- For i=10 To NumPars
- path$=path$+" "+Par$(i)
- Next i
- If ReadFile(0,path$+"BB.Modules.config")
- FileInput 0
- While NOT Eof(0)
- If Edit$(100)="*** Fade ***"
- final=Edit(5)
- EndIf
- Wend
- DefaultInput
- CloseFile 0
- EndIf
- Gosub checkval
- Return
-
- .writeconfig
- Gosub checkval
- If ReadFile(0,path$+"BB.Modules.config")
- If WriteFile(1,path$+"BB.Modules.temp")
- FileInput 0
- FileOutput 1
- While NOT Eof(0)
- f$=Edit$(100)
- If f$="*** Fade ***"
- Repeat
- f2$=Edit$(100)
- Until Eof(0) OR Left$(f2$,3)="***"
- If NOT Eof(0) Then NPrint f2$
- Else
- NPrint f$
- EndIf
- Wend
- CloseFile 1
- EndIf
- CloseFile 0
- EndIf
- KillFile path$+"BB.Modules.config"
- f$=path$+"BB.Modules.temp"+Chr$(0)
- f2$=path$+"BB.Modules.config"+Chr$(0)
- Rename_ &f$,&f2$
- If OpenFile(0,path$+"BB.Modules.config")
- FileOutput 0
- FileSeek 0,Lof(0)
- NPrint "*** Fade ***"
- NPrint final
- CloseFile 0
- EndIf
- Return
-
- .checkval
- If final<0 Then final=0
- If final>99 Then final=99
- Return
-
-